Shareware Grab Bag/Shareware Grab Bag.iso/090/byt0187b.arc/MODULA.LST

File List | 1985-07-12 | 16KB | 844 lines

MODULE filewrite;

(* Write 64 Kbyte disk file -- Logitech version *)



FROM FileSystem IMPORT

    File, Lookup, Close, WriteNBytes;



FROM SYSTEM IMPORT

    ADR;



CONST

    CHUNKSIZE = 128;   (* size of chunks in bytes *)

    NCHUNKS = 512;     (* number of chunks to write *)



TYPE

    chunkarray = ARRAY [1..CHUNKSIZE] OF CHAR;



VAR

        chunk : chunkarray;             (* one chunk *)

        cf : FILE;                      (* chunk file variable *)

        i : CARDINAL;                   (* loop control variable *)

        fs : FileState;                 (* status from Create/Close *)

        name : ARRAY [0..30] OF CHAR;   (* file name *)



BEGIN

    FOR i := 1 TO CHUNKSIZE DO

        chunk[i] := CHR(ORD('1') + (i - 1) MOD 8)

    END;

    name := "C:\TEST.DAT";

        Lookup(cf, name, TRUE);

    FOR i := 1 TO NCHUNKS DO

        WriteNBytes(cf, ADR(chunk), CHUNKSIZE)

    END;

    Close(cf)

END filewrite.







MODULE fileread;

(* 64 Kbyte file read -- LOGITECH version *)



FROM FileSystem IMPORT

    File, Lookup, Close, ReadBytes;



FROM SYSTEM IMPORT

    ADR;



CONST

    CHUNKSIZE = 128;   (* size of chunks in bytes *)

    NCHUNKS = 512;     (* number of chunks to write *)



TYPE

    chunkarray = ARRAY [1..CHUNKSIZE] OF CHAR;



VAR

        chunk : chunkarray;                     (* one chunk *)

        cf : FILE;                                      (* chunk file variable *)

        i : CARDINAL;                           (* loop control variable *)

        junk : CARDINAL;                                (* status from ReadBytes *)

        fs : FileState;                         (* status from Open & Close *)

        name : ARRAY [0..30] OF CHAR;   (* file name *)



BEGIN

    name := "C:\TEST.DAT";

    Lookup(cf, name, TRUE);

    FOR i := 1 TO NCHUNKS DO

        ReadNBytes(cf, ADR(chunk), CHUNKSIZE, junk)

    END;

    Close(cf);

END fileread.









MODULE calculations;

(* Modula-2 program to perform a series of real *)

(* multiplications and divisions *)



FROM RealInOut IMPORT

    WriteReal;



FROM InOut IMPORT

    WriteString, WriteLn;



CONST

    MAX = 5000;         (* number of iterations *)



VAR

    a, b, c : REAL;     (* used in calculations *)

    i : CARDINAL;       (* loop control variable *)



BEGIN

    a := 2.71828;

    b := 3.14159;

    c := 1.0;

    FOR i := 1 TO MAX DO

        c := c * a;

        c := c * b;

        c := c / a;

        c := c / b

    END;

    WriteString('Error = ');

    WriteReal(c - 1.0, 10);

    WriteLn

END calculations.







MODULE sieve;



FROM InOut IMPORT

    WriteLn, WriteString, WriteCard;



CONST

    SIZE = 7000;



VAR

    flags : ARRAY [0..SIZE] OF BOOLEAN;

    i, prime, k, count, iter : CARDINAL;



BEGIN

    WriteString('10 iterations');

        WriteLn;

    FOR iter := 1 TO 10 DO

        count := 0;

        FOR i := 0 TO SIZE DO

            flags[i] := TRUE

        END;

        FOR i := 0 TO SIZE DO

            IF flags[i] THEN

                prime := i + i + 3;

                k := i + prime;

                WHILE k <= SIZE DO

                    flags[k] := FALSE;

                    k := k + prime

                END;

                INC(count)

            END

        END

    END;

    WriteCard(count, 1);

    WriteString(' primes');

    WriteLn

END sieve.







MODULE scout;

(* test character output to screen *)



FROM InOut IMPORT

        Write;



CONST

        MAX = 10000;    (* number of iterations *)



VAR

        i : CARDINAL;



BEGIN

        FOR i := 1 to MAX DO

                Write('a')

        END

END scount.







MODULE precision;

(* determine storage req. and precision of REAL type *)

(* find smallest number for which (1.0 + eps) > 1.0 *)



FROM SYSTEM IMPORT

        TSIZE;



FROM InOut IMPORT

        WriteString, WriteCard, WriteLn;



FROM RealInOut IMPORT

        WriteReal;



VAR

        eps : REAL;



BEGIN

        WriteString('Size of REAL = ');

        WriteCard(TSIZE(REAL), 1);

        WriteString(' bytes');

        WriteLn;



        eps := 1.0;

        REPEAT

                WriteReal(eps, 10);

                WriteLn;

                eps := eps/2.0

        UNTIL 1.0 + eps = 1.0;

END precision.











MODULE underflow;

(* find smallest positive REAL *)



FROM InOut IMPORT

        WriteLn;



FROM RealInOut IMPORT

        WriteReal;



VAR

        x : REAL;



BEGIN

        x := 1.0;

        REPEAT

                WriteReal(x, 10);

                WriteLn;

                x := x/2.0

        UNTIL x = 0.0

END underflow.









MODULE overflow;

(* find largest positive REAL *)



FROM InOut IMPORT

        WriteLn;



FROM RealInOut IMPORT

        WriteReal;



VAR

        x : REAL;



BEGIN

        x := 1.0;

        REPEAT

                WriteReal(x, 10);

                WriteLn;

                x := 2.0 * x

        UNTIL FALSE

END overflow.













MODULE Dhrystone;

FROM InOut IMPORT
    WriteLn, WriteInt, WriteString;

FROM RealInOut IMPORT
    WriteReal;

FROM Storage IMPORT
    ALLOCATE, DEALLOCATE;

FROM Strings IMPORT
    CompareStr;

FROM TimeDate IMPORT
    GetTime, Time;

CONST
    NumberOfExecutions = 10000;
    NumberOfMeasurements = 10;
    LargeRealNumber = 1000000.0;
    MicrosecondsPerClock = 1000.0;

TYPE
    Enumeration = (Ident1, Ident2, Ident3, Ident4, Ident5);
    OneToThirty = [1..30];
    OneToFifty = [1..50];
    CapitalLetter = ['A'..'Z'];
    String30 = ARRAY[0..30] OF CHAR;
    Array1DimInteger = ARRAY OneToFifty OF INTEGER;
    Array2DimInteger = ARRAY OneToFifty, OneToFifty OF INTEGER;
    RecordPointer = POINTER TO RecordType;
    RecordType = RECORD
                PointerComp : RecordPointer;
                CASE Discr : Enumeration OF
                Ident1 :
                                EnumComp : Enumeration;
                                IntComp : OneToFifty;
                                StringComp : String30;
                |
                Ident2 :
                                EnumComp2 : Enumeration;
                                StringComp2 : String30;
                |
                Ident3, Ident4, Ident5 :
                                CharComp1, CharComp2 : CHAR;
                END;
        END;

VAR
    ExecutionIndex : [1..NumberOfExecutions];
    MeasurementIndex : [1..NumberOfMeasurements];
    BeginClock, EndClock, SumClocks, EmptyLoopClocks,
        TimePerExecution, SumTime, MinTime : REAL;

    PointerGlob, NextPointerGlob : RecordPointer;
    IntGlob : INTEGER;
    BoolGlob : BOOLEAN;
    CharGlob1, CharGlob2 : CHAR;
    ArrayGlob1 : Array1DimInteger;
    ArrayGlob2 : Array2DimInteger;
    IntGlob1, IntGlob2, IntGlob3 : OneToFifty;
    CharIndex : CHAR;
    EnumGlob : Enumeration;
    StringGlob1, StringGlob2 : String30;

PROCEDURE Proc1(PointerParVal : RecordPointer);

BEGIN
    WITH PointerParVal^.PointerComp^ DO
                PointerParVal^.PointerComp^ := PointerGlob^;
                PointerParVal^.IntComp := 5;
                IntComp := PointerParVal^.IntComp;
                PointerComp := PointerParVal^.PointerComp;
                Proc3(PointerComp);
                IF Discr = Ident1 THEN
                        IntComp := 6;
                Proc6(PointerParVal^.EnumComp, EnumComp);
                PointerComp := PointerGlob^.PointerComp;
                Proc7(IntComp, 10, IntComp);
                ELSE
                PointerParVal^ := PointerParVal^.PointerComp^;
                END;
    END;
END Proc1;

PROCEDURE Proc2(VAR IntParRef : OneToFifty);

VAR
    IntLoc : OneToFifty;
    EnumLoc : Enumeration;

BEGIN
    IntLoc := IntParRef + 10;
    REPEAT
                IF CharGlob1 = 'A' THEN
                IntLoc := IntLoc - 1;
                IntParRef := IntLoc - CARDINAL(IntGlob);
                EnumLoc := Ident1;
                END;
    UNTIL EnumLoc = Ident1;
END Proc2;

PROCEDURE Proc3(VAR PointerParRef : RecordPointer);

BEGIN
    IF PointerGlob <> NIL THEN
                PointerParRef := PointerGlob^.PointerComp;
    ELSE
                IntGlob := 100;
    END;
    Proc7(10, IntGlob, PointerGlob^.IntComp);
END Proc3;

PROCEDURE Proc4();

VAR
    BoolLoc : BOOLEAN;

BEGIN
    BoolLoc := CharGlob1 = 'A';
    BoolLoc := BoolLoc OR BoolGlob;
    CharGlob2 := 'B';
END Proc4;

PROCEDURE Proc5();

BEGIN
    CharGlob1 := 'A';
    BoolGlob := FALSE;
END Proc5;

PROCEDURE Proc6(EnumParVal : Enumeration; VAR EnumParRef : Enumeration);

BEGIN
    EnumParRef := EnumParVal;
    IF NOT Func3(EnumParVal) THEN
                EnumParRef := Ident4;
    END;
    CASE EnumParVal OF
                Ident1 :
                EnumParRef := Ident1;
                |
                Ident2 :
                IF IntGlob > 100 THEN
                                EnumParRef := Ident1;
                ELSE
                                EnumParRef := Ident4;
                END;
                |
                Ident3 :
                        EnumParRef := Ident2;
                |
                Ident4 :
                Ident5 :
                EnumParRef := Ident3;
        END;
END Proc6;

PROCEDURE Proc7(IntPar1Val, IntPar2Val : OneToFifty;
    VAR IntParRef : OneToFifty);

VAR
    IntLoc : OneToFifty;

BEGIN
    IntLoc := IntPar1Val + 2;
    IntParRef := IntPar2Val + IntLoc;
END Proc7;

PROCEDURE Proc8(VAR ArrayPar1Ref : Array1DimInteger;
        VAR ArrayPar2Ref : Array2DimInteger;
        IntPar1Val, IntPar2Val : INTEGER);

VAR
    IntIndex, IntLoc : OneToFifty;

BEGIN
    IntLoc := IntPar1Val + 5;
    ArrayPar1Ref[IntLoc] := IntPar2Val;
    ArrayPar1Ref[IntLoc + 1] := ArrayPar1Ref[IntLoc];
    ArrayPar1Ref[IntLoc + 30] := IntLoc;
    FOR IntIndex := IntLoc TO IntLoc + 1 DO
                ArrayPar2Ref[IntLoc, IntIndex] := IntLoc;
    END;
    ArrayPar2Ref[IntLoc, IntLoc - 1] := ArrayPar2Ref[IntLoc,IntLoc - 1] + 1;
    ArrayPar2Ref[IntLoc + 20,IntLoc] := ArrayPar1Ref[IntLoc];
    IntGlob := 5;
END Proc8;

PROCEDURE Func1(CharPar1Val, CharPar2Val : CapitalLetter) : Enumeration;

VAR
    CharLoc1, CharLoc2 : CapitalLetter;

BEGIN
    CharLoc1 := CharPar1Val;
    CharLoc2 := CharLoc1;
    IF CharLoc2 <> CharPar2Val THEN
                RETURN Ident1;
    ELSE
                RETURN Ident2;
    END;
END Func1;

PROCEDURE Func2(VAR StringPar1Ref, StringPar2Ref : String30) : BOOLEAN;

VAR
    IntLoc : OneToThirty;
    CharLoc : CapitalLetter;

BEGIN
    IntLoc := 2;
    WHILE IntLoc <= 2 DO
                IF Func1(StringPar1Ref[IntLoc], StringPar2Ref[IntLoc+1]) = Ident1 THEN
                CharLoc := 'A';
                IntLoc := IntLoc + 1;
                END;
    END;
    IF (CharLoc >= 'W') AND (CharLoc < 'Z') THEN
                IntLoc := 7;
    END;
    IF CharLoc = 'X' THEN
                RETURN TRUE;
    ELSIF CompareStr(StringPar1Ref, StringPar2Ref) > 0 THEN
                IntLoc := IntLoc+7;
                RETURN TRUE;
    ELSE
                RETURN FALSE;
    END;
END Func2;

PROCEDURE Func3(EnumParVal : Enumeration) : BOOLEAN;

VAR
    EnumLoc : Enumeration;

BEGIN
    EnumLoc := EnumParVal;
    IF EnumLoc = Ident3 THEN
                RETURN TRUE;
    END;
END Func3;

PROCEDURE clock() : REAL;

VAR
    Now: Time;
    milliseconds: CARDINAL;
    seconds: CARDINAL;
    minutes: CARDINAL;
    hours: CARDINAL;

BEGIN
    GetTime(Now);
    WITH Now DO
                seconds := millisec DIV 1000;
                milliseconds := millisec MOD 1000;
                hours := minute DIV 60;
                minutes := minute MOD 60
    END;
    RETURN FLOAT(milliseconds)+1000.0*(FLOAT(seconds)+60.0*(FLOAT(
                minutes)+60.0*FLOAT(hours)));
END clock;

BEGIN
    NEW(NextPointerGlob);
    NEW(PointerGlob);
    PointerGlob^.PointerComp := NextPointerGlob;
    PointerGlob^.Discr := Ident1;
    PointerGlob^.EnumComp := Ident3;
    PointerGlob^.IntComp := 40;
    PointerGlob^.StringComp := 'DHRYSTONE PROGRAM, SOME STRING';
    StringGlob1 := "DHRYSTONE PROGRAM, 1'ST STRING";
    WriteLn();
    WriteString('Dhrystone Benchmark (March 84), Version Pascal / 2');
    WriteLn();
    WriteString('Times are CPU user time per execution, in microseconds');
    WriteLn();
    WriteLn();
    SumTime := 0.0;
    MinTime := LargeRealNumber;
    FOR MeasurementIndex := 1 TO NumberOfMeasurements DO
                BeginClock := clock();
                Array2Glob[8][7] := 10;
                FOR ExecutionIndex := 1 TO NumberOfExecutions DO
                Proc5();
                Proc4();
                        IntGlob1 := 2;
                IntGlob2 := 3;
                StringGlob2 := "DHRYSTONE PROGRAM, 2'ND STRING";
                EnumGlob := Ident2;
                BoolGlob := Func2(StringGlob1,StringGlob2);
                WHILE IntGlob1<IntGlob2 DO
                                IntGlob3 := 5 * IntGlob1 - IntGlob2;
                                Proc7(IntGlob1, IntGlob2, IntGlob3);
                                IntGlob1 := IntGlob1+1;
                END;
                Proc8(ArrayGlob1, ArrayGlob2, IntGlob1, IntGlob3);
                        Proc1(PointerGlob);
                FOR CharIndex := 'A' TO CharGlob2 DO
                                IF EnumGlob = Func1(CharIndex, 'C') THEN
                                         Proc6(Ident1, EnumGlob);
                                END;
                END;
                IntGlob3 := IntGlob2 * IntGlob1;
                IntGlob2 := IntGlob3 DIV IntGlob1;
                IntGlob2 := 7 * (IntGlob3 - IntGlob2) - IntGlob1;
                Proc2(IntGlob1);
                END;
                EndClock := clock();
                SumClocks := (EndClock - BeginClock) * MicrosecondsPerClock;
                BeginClock := clock();
                FOR ExecutionIndex := 1 TO NumberOfExecutions DO
                END;
                EndClock := clock();
                EmptyLoopClocks := (EndClock - BeginClock) * MicrosecondsPerClock;
                SumClocks := SumClocks - EmptyLoopClocks;
                TimePerExecution := SumClocks / FLOAT(NumberOfExecutions);
                WriteString('Time for run ');
                WriteInt(MeasurementIndex, 4);
                WriteString(': ');
                WriteReal(TimePerExecution, 10);
                WriteLn();
                SumTime := SumTime+TimePerExecution;
                IF TimePerExecution<MinTime THEN
                        MinTime := TimePerExecution;
                END;
    END;
    WriteLn();
    WriteString('Average execution time: ');
    WriteReal(SumTime/FLOAT(NumberOfMeasurements), 10);
    WriteLn();
    WriteLn();
    WriteString('Minumum execution time: ');
    WriteReal(MinTime, 10);
    WriteLn();
    WriteLn();
END Dhrystone.